00100	C***** BEAMS,  XNOTE, BAUTO, UPDATE, SLEND, POSIT *******
00200		SUBROUTINE BEAMS
00300		INTEGER UPDN
00400		COMMON/XRN/RN(2000)
00500		COMMON/RINP/R(10,80),POSNT(0/99) /RMOD/RMODE2,SET4,IBEAM,
00600		1 NOSET,STEM,STUP,NTC,PS2,RAM,RDD,IT,POS
00700		1 /FRMT/F78F(1),FA1(1),FA5(1),IREAD /ALF/INP(72),ML
00800		1 /PTR/PWDS(250),ITEM,LL,IS,IX
00900		COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
01000		COMMON R2,JAZ,CENTR,JBZ,RJQ(20),JQ(20) /STF/RSTFAC(8),RSTJ2
01100		COMMON/SCX/RHY(4),JALPHA(30),JX,U,JZ,IRHY,JD,KA,KB,IZ
01200		1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
01300		1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
01400		DATA BX/25./,BY/.5/,DFAC/6./,CURV/0.9/
01500	C  THESE ARE USED TO DETERMINE CURVE OF SLURS AT 63 (21700)
01600	
01700		IF(RMODE.LT.500)GO TO 251
01800		IF(MODE.EQ.4)RETURN
01900	C  PICKS UP SLURS ONLY WHEN USING SUBR. 'EXTRA' *********
02000	251	INVT=-1
02100		IF(MODE.EQ.3)GO TO 25
02200		IF(MODE.EQ.5)NTC=NTC-1
02300	C  NTC=NUM OF NTS NOW
02400		IF(REND.NE.0)GO TO 25
02500		REND=3
02600	25	DO 1500 K=1,72
02700		IF(INP(K).EQ.'B')GO TO 22
02800	C  B=AUTOMATIC BEAMS.
02900		IF(INP(K).NE.'*')GO TO 1500
03000	15	INP(72)='*'
03100		GO TO 500
03200	1500	IF(INP(K).EQ.ISEMI)GO TO 500
03300		GO TO 15
03400	C ABOVE FOR 2ND LNE OF INPUT. IF LNS ENDS WITHOUT * OR ;, IT PUTS IN *
03500	22	REREAD F78F,A,RB,RC
03600	C  TYPE '2B' OR '3B' ETC. FOR AUTOMATIC BEAMS. (2=DUPLE  3=TRIPLE)
03700		IF(IREAD.NE.-1)GO TO 2222
03800		A=RB
03900		RB=RC
04000	C  IREAD=-1 WHEN READING SOS FILES. (=-2 WITH ET FILES.)
04100	2222	A=A/2.
04200	C  '2'=1  '3'=1.5   '2B 3;'  MEANS THERE'S A 3 NOTE PICK-UP.
04300		IF(STEM)STEM=0
04400	C STEM=10 OR 20 IF ALREADY SETUP IN NOTES
04500		N=0
04600		J=0
04700		INP(72)='*'
04800	
04900		GR=4./88.
05000		NN=0
05100		NZ=0
05200		NL=1
05300		NJ=0
05400		NR=1
05500		JV=0
05600	C  JV IS VX COUNTER
05700		C=0
05800		B=A-.001
05900		IF(RB.EQ.0)GO TO 122
06000		J=RB
06100	C RB=NUM OF PICKUP ITEMS.*******(NTS AND RSTS - BUT NOT GRACE NTS.)*******
06200		B=-.001
06300		DO 222 K=1,J
06400	222	IF(V(K).NE.GR)B=B+ABS(V(K))
06500	C  ABOVE FOUND VALUE OF PICKUPS
06600	122	X=ABS(V(NR))
06700		IF(X.NE.GR)GO TO 2122
06800		NN=NN+1
06900		GO TO 2022
07000	2122	C=C+X
07100	C  ADD ON RHYTH VALUE -- IF NOT GRACE NOTES
07200		IF(V(NR))N=N+1
07300	C  FINDS RESTS AND GRACE NOTES (WE SKIP THEM)
07400		IF(C.GT.B)GO TO 822
07500	CC	IF(NOTAIL(X))NL=NR
07600	2022	IF(NR.EQ.IRHY)GO TO 422
07700	922	NR=NR+1
07800	C  NR=RIGHT SIDE OF BEAM, NL=LEFT
07900		GO TO 122
08000	CC***822	IF(NR-NL-NN-N.GE.0)GO TO 322
08100	822	IF(NR-NL-NN-N.GT.0)GO TO 322
08200	C  IGNORE IF ONLY ONE NOTE FILLS UNIT
08300	CC	N=NN+N
08400	C  UPDATE REST AND GRACE COUNTER
08500	722	IF(NR.EQ.IRHY)GO TO 422
08600		NN=0
08700		NJ=NJ+N
08800		NZ=NJ  
08900		N=0
09000		NL=NR+1
09100	C PUSH AHEAD FOR NEXT BEAM
09200	622	B=B+A
09300	C UPDATE SPACE POINTER
09400		IF(C.GT.B)GO TO 622
09500		GO TO 922
09600	
09700	322	KR=0
09800		NX=0
09900	2322	IF(V(NL).NE.GR)GO TO 3322
10000	C AVOIDS LEADING GRACE NOTES
10100		NL=NL+1
10200		GO TO 2322
10300	3322	K=NL
10400		DO 522 J=K,NR
10500		X=V(J)
10600	CC	IF(X.GT.0)GO TO 1822
10700		IF(X)NX=NX+1
10800	C LOCAL COUNTER FOR RESTS.
10900	CC	GO TO 1622
11000	1822	IF(NOTAIL(X))GO TO 6622
11100	C  X≤ 10.  8.  8..
11200		IF(X.GE.0)KR=J-NX
11300	C  RIGHT SIDE OF BEAM
11400	1622	IF(J.NE.NR)GO TO 522
11500	C ALWAYS STOP ON LAST OF GROUP
11600	6622	IF(KR.GT.NL)CALL BAUTO(JV,NL,KR,NZ)
11700		NZ=NZ+NX
11800		KR=0
11900	  	NX=0
12000		NL=J+1
12100	522	CONTINUE
12200		GO TO 722
12300	C  MAIN AUTO BEAM LOOP ↑↑↑↑
12400	
12500	C  NEXT FOR BEAMED GRACE NOTES
12600	422	N=0
12700		J=1
12800	1122	X=V(J)
12900		IF(X)N=N+1
13000		NR=0
13100		IF(X.NE.GR)GO TO 1022
13200		NL=J
13300		DO 1222 K=J,IRHY
13400		X=V(K)
13500		IF(X.OR.X.NE.GR)GO TO 1322
13600	C  STOPS GRACE NOTE BEAM AT REST OR NON-GRACE
13700	1222	NR=K
13800	1322	IF(NR-NL.LE.0)GO TO 1022
13900		CALL BAUTO(JV,NL,NR,N)
14000	C UPDATE VX COUNTER
14100		NL=NL+1
14200		J=NR
14300	1022	J=J+1
14400		IF(J.LE.IRHY)GO TO 1122
14500	
14600	1422	IF(JV.EQ.0)RETURN
14700	C  NO BEAMS - SO GO BACK.
14800		DO 2822 K=JV+1,50
14900	C  USES ONLY 68 SLOTS IN 'V'
15000	2822	VX(K)=0
15100		J=0
15200		GO TO 511
15300	
15400	C  *******  1ST MAIN LOOP *********
15500	500	REREAD F78F,VX
15600		J=0
15700		IF(IREAD.EQ.-1)J=1
15800	C  SKIPS LINE #S IN SOS FILES. (=-2 IS FOR ET FILES.)
15900	511	J=J+1
16000		N=VX(J)
16100		JMP=1
16200		JREP=-1
16300	C  JREP IS FOR REPEAT FEATURE IN 'MARKS'
16400	505	L=0
16500		K=0
16600		POS=-10.
16700		IF(MODE.EQ.3)GO TO 5032
16800	C  MODE 3 IS FOR ACCENTS ETC.
16900		RN(8+IS)=0
17000		RN(9+IS)=0
17100		IT=0
17200		UPDN=0
17300		IF(MODE.EQ.5)GO TO 104
17400		IF(STEM.EQ.0)GO TO 503
17500	C  UPDN=2=STEMS DOWN, (SLUR DIP UP)  =1, OPPOSITE.
17600	104	JA=J+1
17700		B=VX(JA)
17800	C THE 2ND NOTE (-=DIP DOWN ALWAYS; +100=UP ALWAYS, ORD.=AUTOMATIC)
17900		IF(B.LT.100)GO TO 512
18000		UPDN=2
18100		B=B-100
18200		IF(B.GT.100)B=100-B
18300	C  TYPE -NUM OR 200+NUM FOR DIP DOWN.
18400	512	IF(B)UPDN=1
18500		VX(JA)=B
18600		RN(9+IS)=0
18700		BRK=AMOD(VX(J),1.)*10.
18800		IF(BRK.EQ.0)GO TO 503
18900	C ADDS NUM TO BRACK. OR BEAM. ADD DESIRED .NUM TO 1ST NUM.(1.3=3)
19000		RN(9+IS)=BRK+.0001
19100		GO TO 5030
19200	503	IF(N.GT.0)GO TO 5031
19300		IT=-1
19400	C6/75	POS=-1.3
19500		CALL SLEND
19600	C  -1= SLUR INTO 1ST NOTE.
19700	C  SETS POS OF LFT SIDE (-10+9, THEN +2)
19800		GO TO 5060
19900	5031	IF(N.LE.NTC)GO TO 5030
20000	C  NTC=NUM OF NTS
20100	C6/75	POS=202
20200		CALL SLEND
20300	C  SLEND CHECKS ON END POINTS OF THIS STAFF
20400		GO TO 504
20500	C  -1=1ST SLUR FROM NO NOTE; 99= LAST, TO NO NOTE
20600	5032	IF(N.GT.IRHY)N=IRHY
20700	C TRAPS ERROR OF TRYING TO PUT MARK ON NON-EXISTENT NOTE.
20800	5030	L=L+1
20900	502	K=K+1
21000		IF(R(1,K).NE.1.)GO TO 502
21100	C  IS IT A NOTE?
21200		P=R(3,K)
21300		IF(P.EQ.POS)GO TO 502
21400	C  SKIPS DBLSTPS
21500		POS=P
21600	506	IF(L.LT.N)GO TO 5030
21700	5060	IF(MODE.EQ.3)GO TO 30
21800	C  NOW SLUR STARTS
21900		IF(JMP)GO TO 504
22000	C  JMP=-1 MEANS END NOTE OF GROUP
22100		J=J+1
22200		NN=VX(J)
22300	C  IF 2ND NUM IS .LE. 1ST , THEN 2-NOTE SLUR. (-1 GOES TO 1)
22400		IF(NN.EQ.0)NN=N+1
22500		IF(NN.EQ.0)NN=1
22600		IF(NN)GO TO 777
22700		IF(NN.LE.N)NN=N+1
22800	C  FOR USE WITH AUTO-BEAMS OR DIP UP.  2-NOTE SLUR OR BEAM UP.
22900	777	IF(MODE.NE.4)GO TO 5061
23000		IF(STEM.LE.0)GO TO 5061
23100	C  AUTOMATIC DIP DIRECTION FOR SLURS WITH AUTO. BEAMS.
23200	177	MK=K
23300	877	IF(R(1,MK).EQ.1)GO TO 477
23400		MK=MK+1
23500		GO TO 877
23600	C  FOR SLUR INTO FIRST NOTE WITH AUTO BEAMS.
23700	477	IF(R(10,MK).EQ.0)GO TO 1077
23800	C SKIP NOTES ON ANOTHER STAFF.
23900		MK=MK+1
24000		GO TO 477
24100	1077	A=19.-R(5,MK)
24200		IF(NN.GE.0)GO TO 277
24300		IF(A.GT.0)GO TO 377
24400	277	IF(A.GE.0)GO TO 5061
24500		IF(NN.LE.0)GO TO 5061
24600	377	NN=-NN
24700	5061	MK=N
24800		N=IABS(NN)
24900		M=K
25000		JA=3
25100		JB=4
25200		KN=K
25300		RB=0
25400		IF(MODE.EQ.4)GO TO 550
25500		IBR=6
25600	C  6=SLUR, 7=BRACK. FOR TRIPLETS, ETC.
25700	CC*** NOT NEEDED NOW WITH UPDN FEATURE.	IF(STEM.GE.0)NN=-NN
25800		IF(IT)GO TO 550
25900	C  IT=-1=SLUR INTO 1ST NOTE.
26000		A=XNOTE(K)
26100	C XNOTE IS AMOD(R(4,K),100.)
26200	C  SAVES LEVEL OF 1ST NOTE.
26300	504	RB=2
26400	CS	B=AMOD(R(6,K),1.0)
26500	CS	IF(B.GE.0.5)RB=3.
26600	CS	IF(B.EQ.0.4)RB=5.
26700	C   THESE ARE FOR >(.5) AND ∧(.4) ACCENTS
26800		IF(NN)RB=-RB
26900	C  DIP IS SET BY PARAM 7. (STEM DIR. IS AUTOMATIC)
27000	550	RN(JA+IS)=POS
27100		B=XNOTE(K)
27200		IF(MODE.EQ.4)GO TO 519
27300	C  TO MAKE MINI-BEAMS ON GRACE NOTES WHEN NEEDED.
27400		IF(MODE.NE.5)GO TO 513
27500		SLUR=0
27600	C A FLAG FOR LATER USE.
27700		MB=R(5,K)/10.
27800		IF(UPDN.EQ.0)GO TO 515
27900		IF(MB.EQ.0)MB=UPDN
28000	C  MB=0 IF 2ND NOTE IS WITHOUT STEM
28100		IF(MB.EQ.UPDN)GO TO 515
28200		X=6
28300		IF(NN)X=-X
28400	CS	IF(RB)X=-X
28500		RB=RB+X
28600		JA=3
28700		IF(JMP)JA=6
28800		IF(NN)GO TO 204
28900	CS	IF(RB)GO TO 204
29000		IF(UPDN.EQ.2)GO TO 516
29100	204	IF(UPDN.EQ.1)GO TO 516
29200	C  ABOVE FOR VARIOUS COMBINATIONS OF STEM DIRECTIONS
29300		RB=-RB
29400		NN=-NN
29500	516	IF(K.GT.1)GO TO 16
29600		IF(IT)GO TO 513
29700	16	IF(K.NE.NTC)GO TO 116
29800		IF(N.GT.NTC)GO TO 513
29900	C JUMP IF N=99, BY PASS IF K IS NOT LAST NOTE OF LINE.
30000	116	SLUR=1.
30100		IF(UPDN.EQ.1)SLUR=-SLUR
30200		SLUR=SLUR*RSTJ2
30300		RN(JA+IS)=RN(JA+IS)+SLUR
30400	C  THIS NOT DONE IF SLUR TO FIRST NOTE
30500		GO TO 513
30600	519	SDIF=R(10,K)
30700		IF(SDIF.EQ.0)GO TO 513
30800	C JUMP IF IT'S NOT ON DIFF STF.
30900		RA=RSTJ2*2.44
31000	C  NOTE WIDTH
31100		IF(ABS(R(4,K)).LT.80)GO TO 520
31200		RA=RA*.6
31300		IF(JMP)B=B-100
31400	C  MINI
31500	520	IF(SDIF.EQ.2)RA=-RA
31600	C  STAFF ABOVE
31700		RN(JA+IS)=POS+RA
31800	C  ***** THIS CAN BE OFF A LITTLE IN SOME CASES!!******
31900		SDIF=SDIF*5
32000		IF(SDIF.NE.10)SDIF=20
32100	CHANGES 1 TO 20, 2 TO 10.
32200		GO TO 513
32300	
32400	
32500	517	IF(MB.EQ.1)GO TO 513
32600		IF(RB)RB=-RB
32700		GO TO 518
32800	515	UPDN=MB
32900	C AUTO SLUR DIP DEPENDS ON STEM DIREC. OF 1ST NOTE. (WHOLE NTS??)
33000		IF(NN)GO TO 517
33100		IF(MB.NE.1)GO TO 513
33200		RB=-RB
33300	518	NN=-NN
33400	513	RN(JB+IS)=B+RB
33500	C  MK=# OF 1ST NOTE, N=END NOTE NOW
33600		JMP=-JMP
33700		IF(JMP.GT.0)GO TO 1503
33800	C  GO FIND RT. SIDE OF SLUR
33900		JA=6
34000		JB=5
34100		IF(N.LE.MK)N=MK+1
34200	C  PICKS UP TYPO ERRORS
34300		JK=0
34400		IF(R(7,K).GE.10)JK=-1
34500	C  CHECKS FOR DOT AFTER 1ST NOTE -- FOR TIES.
34600		GO TO 503
34700	
34800	1503	RN(2+IS)=STAFF
34900		IF(MODE.EQ.4)GO TO 35
35000	C NEXT TO SHIF SLUR IN RE. TO MARKS. STAC., TEN., ACC.
35100	C ***********KN = 1ST NOTE, K=LAST NOTE.********
35200		JA=KN
35300		JB=4
35400	2503	RB=R(2,JA)
35500		IF(RB.EQ.0)GO TO 3503
35600		IF(RB.EQ.4.OR.RB.EQ.5)GO TO 4503
35700		IF(RB.NE.7.AND.RB.NE.9)GO TO 3503
35800		RB=1.5
35900	 	IF(R(5,JA).LT.20)RB=-RB
36000		RN(IS+JB)=RN(IS+JB)+RB
36100		GO TO 3503
36200	4503	L=R(9,JA)
36300	C THE POINTER TO P11 WAS SAVED HERE BY 'NEWR'
36400		RN(L)=RN(L)+.2
36500	3503	IF(JA.EQ.K)GO TO 5503
36600		JA=K
36700		JB=JB+1
36800		GO TO 2503
36900	
37000	5503	RN(8+IS)=-1
37100		RN(1+IS)=5
37200		IF(IT)RN(4+IS)=RN(5+IS)
37300		NN=-NN
37400	C  IF NN IS NEG. NOW IT MEANS STEM DOWN.(DIP IS UP!)
37500		IF(MK.EQ.IRHY)GO TO 61
37600		IF(N.EQ.1)GO TO 61
37700		IF(IT)GO TO 60
37800		IF(XNOTE(K).NE.A)GO TO 60
37900		IF(N-MK.GT.1)GO TO 60
38000	CCC	IF(R(5,M).NE.R(5,K))GO TO 65
38100	CCC  FOR SLUR OVER CHROMATIC CHANGE ON SAME NOTE NAME.
38200	C  M=1ST NOTE OF SLUR, K=LAST
38300		IF(AMOD(R(5,K),10.0).GT.0)GO TO 65
38400	C  JUMP IF LAST NOTE AS ACCI.
38500	C  JUMP IF NOT ADJACENT NOTE AT SAME PITCH AND NOT 1ST OR LAST.
38600	61	C=9
38700		IF(JK)C=12
38800		IF(RN(6+IS)-RN(3+IS)-C*RSTJ2)GO TO 65
38900	C  JUMP IF SLUR IS VERY SHORT
39000		IF(IT)A=XNOTE(K)
39100	C  IT=-1=SLUR INTO 1ST NOTE.
39200		A=A+.7
39300		IF(NN.GT.0)A=A-1.4
39400	C  TO RAISE OR LOWER IT .5
39500		RN(4+IS)=A
39600		RN(5+IS)=A
39700		B=-2
39800		IF(JK)B=-3
39900	C  JK=-1 WHEN NOTE IS DOTTED.
40000	C THIS PUTS TIE BETWEEN (NOT ABOVE OR BELOW) NTS. NO STEM CHNG.
40100		RN(8+IS)=B
40200		IF(SLUR.EQ.0)GO TO 65
40300		RN(3+IS)=RN(3+IS)-SLUR
40400		RN(6+IS)=RN(6+IS)-SLUR
40500	C  PUSH SLUR BACK TO WHERE IT WAS
40600		GO TO 65
40700	
40800	C** 6/16/75 60	IF(STEM.GE.0)GO TO 508
40900	60	IF(STEM.GE.0)GO TO 200
41000		IF(MODE.EQ.5)GO TO 200
41100	C  JUMP IF SLURS**************
41200	C  NEXT IS STEM INVERTER.  SKIP IF AUTOMATIC BEAMS OR 'SU' 'SD' IN USE.
41300		JB=1
41400		RB=10.
41500		IF(NN)GO TO 509
41600	C  IF NN IS NEG. NOW IT MEANS STEM DOWN.(DIP IS UP!)
41700		RB=-RB
41800		JB=2
41900	509	DO 507 L=M,K
42000		IF(R(1,L).NE.1.)GO TO 507
42100		JA=R(5,L)/10.
42200		IF(JA.NE.JB)GO TO 507
42300		IF(R(10,L).NE.0)GO TO 507
42400	C LEAVE NOTE ON OTHER STAFF ALONE.
42500		R(5,L)=R(5,L)+RB
42600		INVT=0
42700	C**********************************************
42800	507	CONTINUE
42900		GO TO 200
43000	62	IF(NN)GO TO 64
43100		IF(A.EQ.DMAX)GO TO 65
43200		AA=B-DMAX
43300		GO TO 63
43400	65	AA=0
43500		GO TO 63
43600	64	IF(A.EQ.UMAX)GO TO 65
43700		AA=UMAX-B
43800	63	RA=RN(6+IS)
43900		RB=RN(3+IS)
44000		X=CURV+(RA-RB)/BX+ABS(RN(4+IS)-RN(5+IS))/10.
44100	C  CURVE DEPENDS ON LENGTH, TILT AND NOTES BETWEEN.
44200		IF(AA.GT.0)X=X+AA*BY
44300		IF(BRK.EQ.0)GO TO 66
44400		RN(8+IS)=1
44500		RN(3+IS)=RB-.6
44600		RB=R(3,K+1)
44700	C  K=END NOTE OF GROUP
44800		IF(K.EQ.IZ)RB=200.
44900	C IZ IS LAST ITEM IN R(N,M)
45000	C****	IF(K.EQ.IRHY)RB=200.
45100	C  ASSUMES LINE STOPS AT 200. (IT COULD BE LONGER!!)
45200		RN(6+IS)=RA+(RB-RA)/2.
45300		IBR=7
45400	C  CHECK THESE NUMBERS↑↑↑↑
45500		B=RN(4+IS)
45600		BB=RN(5+IS)
45700		RA=1
45800		IF(A.LT.-1)RA=2.5
45900	C  CHANGES HEIGHT.  MAKES BRACK. IF N>100.
46000		IF(NN.GT.0)RA=-RA
46100		RN(4+IS)=B+RA
46200		RN(5+IS)=BB+RA
46300		X=2
46400	66	IF(NN.GT.0)X=-X
46500	510	RN(7+IS)=X
46600		IF(MODE.NE.4)GO TO 2514
46700	CC	RN(9+IS)=0
46800		RN(10+IS)=0
46900		RN(IS+11)=-1
47000		CALL UPDATE(9)
47100		IF(JB)CALL BMX(RA)
47200		GO TO 514
47300	2514	L=IS
47400		CALL UPDATE(IBR)
47500		IF(M.EQ.K)GO TO 514
47600	C JUMP OUT IF INTERVENING NOTE.
47700		IF(RN(L+4).NE.RN(L+5))GO TO 514
47800	C  IS IT LEVEL?
47900		B=-RN(IS-2)
48000	C CHANGE DIRECTION OF DIP AFTER FIRST SLUR.
48100		RA=1.4
48200		IF(RN(L+8).EQ.-1)RA=RA+1.3
48300	C  IS TIE NOT BETWEEN NOTES?
48400		IF(NN.GT.0)RA=-RA
48500	C DIP DIRECTION.  NN+ =DOWN, NN- =UP.  REVERSED AFTER 1ST ONE.
48600		RA=XNOTE(M)+RA
48700		C=-2.
48800		IF(RN(L+8).EQ.-3.)C=-3.
48900	C PUT TIE BETWEEN NOTES ALWAYS.
49000		JA=M
49100		JB=K
49200	114	JA=JA+1
49300		JB=JB+1
49400		IF(R(3,JB).NE.POS)GO TO 514
49500	C JUMP IF RIGHT-HAND NOTE NOT IN SAME POS.
49600		IF(R(1,JA).NE.1)GO TO 514
49700	C  CATCHES THINGS BETWEEN NOTES
49800		IF(R(4,JA).NE.R(4,JB))GO TO 514
49900	C  LOOKS FOR  PARALLEL CHORDS NOTES
50000	CRH	IF(R(9,JA)+R(9,JB).NE.0)GO TO 514
50100	C  MAKES SURE THEY ARE CHORD NOTES.
50200		A=XNOTE(JA)-RA+RN(L+5)
50300		RN(IS)=6.
50400		RN(IS+1)=5.
50500		RN(IS+2)=RN(IS-7)
50600		RN(IS+3)=RN(IS-6)
50700		RN(IS+6)=RN(IS-3)
50800		RN(IS+7)=B
50900		RN(IS+8)=C
51000		RN(IS+4)=A  
51100		RN(IS+5)=A  
51200		CALL UPDATE(IBR)
51300		GO TO 114
51400	514	J=J+1
51500		A=VX(J)
51600		N=A
51700	C  SO ITEMS NEED NOT BE IN RIGHT ORDER.
51800		IF(MOD(N,100).GT.IRHY)A=0
51900		IF(A.NE.0)GO TO 505
52000	CC***USE NO NUMBS IN COMMENTS IN MODE 3-5******	IF(VX(J+2).EQ.0)GO TO 614
52100		IF(J.LT.50)GO TO 514
52200	C  SOMETIMES A SLASH IS SEEN AS A 0 (WHEN PRECEDED BY SPACE).
52300	614	IF(INP(72).NE.'*')GO TO  552
52400		IF(INVT)RETURN
52500		INVT=IS
52600		CALL NEWR
52700		IS=INVT
52800		RETURN
52900	552	IF(IREAD.NE.0)GO TO 3501
53000		CALL TYPE
53100		WRITE(21,4501)INP
53200		GO TO 5501
53300	3501	IF(IREAD.EQ.-1)READ(22,2501)J,INP
53400		IF(IREAD.EQ.-2)READ(22,4501)INP
53500		CALL TYPOUT
53600	5501	CALL LNEND
53700	C  FOR NEW 'SCORE' CONVENTIONS
53800	C  TO READ MORE THAN 2 LINES.
53900		GO TO 25
54000	C  FOR 2ND LINE.
54100	4501	FORMAT(72A1)
54200	2501	FORMAT(I,72A1)
54300	
54400	
54500	35	RA=10.
54600	C  RA WILL=# OF TAILS,  KN=1ST NOTE, K=LAST ('MOD' FOR DOTTED NOTES.)
54700		RN(1+IS)=6
54800		JMAX=0
54900		IF(N-MK.EQ.1)JMAX=-1
55000		DMAX=100.
55100		UMAX=-DMAX
55200	C  FOR AUTO. BEAMS
55300	
55400		JB=0
55500		MB=0
55600	C MB=-1 =GRACE NOTES UNDER BEAMS.  
55700		IF(ABS(R(4,KN)).GE.80.)MB=-1
55800		DO 2 L=KN,K
55900		IF(R(1,L).NE.1)GO TO 2
56000		IF(R(10,L).NE.0)GO TO 2
56100	C SKIP NOTES ON ANOTHER STAFF.
56200		BB=R(5,L)
56300		IF(BB.GE.10.)GO TO 12
56400		UPDN=-1
56500		NN=19-AA
56600	CHORDS WILL HAVE FIXED STEM DIRECTIONS ALWAYS
56700		GO TO 2
56800	C  SKIPS NON-NOTES AND DBLSTPS
56900	12	IF(MB)GO TO 10
57000		AA=BB
57100		RB=R(4,L)
57200		IF(ABS(RB).GE.80)GO TO 2
57300	C  SKIPS GRACE NOTES
57400		GO TO 110
57500	10	RB=XNOTE(L)
57600	110	IF(RB.GT.UMAX)UMAX=RB
57700		IF(RB.LT.DMAX)DMAX=RB
57800	C  FOR AUTO. BEAMS
57900		RB=AMOD(R(7,L),10.0)
58000	112	IF(RA.EQ.RB)GO TO 2
58100		JB=-1
58200	C   FLAG FOR MIXED NUM. OF BEAMS
58300		IF(RB.GE.RA)GO TO 2
58400		IF(RB.NE.0)RA=RB
58500	2	CONTINUE
58600	C  ABOVE FINDS SMALLEST # OF TAILS.  NEXT FOR HGTS.
58700	C  ABOVE IS POS.2
58800		IT=K
58900	C  FOR EXTRA BEAMS WITH CHORDS. SAVE IT IN "IT"
59000		IF(STEM.GT.0)GO TO 577
59100	C  *****↑↑↑↑↑↑ ABOVE WAS ".NE." BEFORE 4/30/76. WHY?#@&Xαε
59200		IF(UPDN.NE.0)GO TO 577
59300		IF(UMAX+DMAX.GE.14)NN=-1
59400	CXX	IF(STEM.GT.0)NN=10.-STEM
59500	C  SETS AUTO. BEAMS' STEM DIRECTION.
59600	577	X=10
59700		IF(NN)X=20
59800		IF(SDIF.NE.0)X=SDIF
59900		IF(MB)RA=2
60000	C  2 BEAMS ON GRACE NOTES ALWAYS
60100		X=X+RA
60200	C  # OF BEAMS.  IT'S PUT IN  DOWN BELOW 550.
60300	200	M=KN
60400	207	L=M+1
60500		IF(R(1,L).NE.1)GO TO 307
60600	CC	IF(R(9,L).NE.0)GO TO 307
60700		IF(R(5,L).GE.10)GO TO 307
60800		M=M+1
60900		GO TO 207
61000	C  FOR HEIGHTS OF DBL STPS, ETC.
61100	307	IF(R(10,M).EQ.0)GO TO 607
61200		M=M+1
61300	C SKIP NOTES ON OTHER STAFF
61400		GO TO 307
61500	607	A=XNOTE(M)
61600	CW307	A=XNOTE(M)
61700	C   A=NOTE 1.
61800		UMAX=A
61900		DMAX=A
62000	C  UP MAX. NOTE #, DOWN MAX. NOTE #.
62100	407	M=K+1
62200		IF(R(1,M).NE.1)GO TO 103
62300	CC	IF(R(9,M).NE.0)GO TO 103
62400		IF(R(5,M).GE.10)GO TO 103
62500	C  FINDS DBL+ STP ON LAST OF BEAM
62600		K=M
62700		GO TO 407
62800	103	DO 3 M=KN,K
62900		IF(R(1,M).NE.1)GO TO 3
63000		IF(R(10,M).NE.0)GO TO 3
63100	C SKIP NOTES ON OTHER STAFF
63200		IF(M.EQ.K)GO TO 107
63300	CW	IF(R(10,M).NE.0)GO TO 107
63400		IF(R(1,M+1).NE.1)GO TO 107
63500	C IT ONLY CARES ABOUT NOTES!
63600	CC	IF(R(9,M+1).EQ.0)GO TO 3
63700		IF(R(5,M+1).LT.10)GO TO 3
63800	C IGNORE LOWER (OR UPPER) NOTES OF CHORDS (NO STEM)-IN RE. UP-DOWN FEATURE.
63900	107	IF(MB)GO TO 7
64000	C  SKIP IF DEALING WITH GRACE NOTE BEAMS. (MB=-1)
64100		IF(ABS(R(4,M)).GE.100)GO TO 3
64200	C  SKIPS NON-NOTES
64300	7	B=XNOTE(M)
64400		IF(MODE.EQ.5)GO TO 55
64500	677	IF(R(10,M).NE.0)GO TO 55
64600	C  DON'T CHANGE STEM DIR. IF NOTE IS ON OTHER STAFF!!!!
64700		STMDR=R(5,M)
64800		IF(NN.GT.0)GO TO 5
64900	C  JUMP IF STEM UP
65000		IF(STMDR.GE.20.)GO TO 55
65100		IF(STMDR.LT.10.)GO TO 55
65200		R(5,M)=STMDR+10.
65300		GO TO  551
65400	5	IF(STMDR.LT.20.)GO TO 55
65500		R(5,M)=STMDR-10.
65600	C************************
65700	C    STEM UP
65800	551	INVT=0
65900	55	IF(B.LT.UMAX)GO TO 13
65910	CC55	IF(B.LE.UMAX)GO TO 13
66000	C ↑↑↑↑↑↑↑↑ WAS .LT. !!!!! 5/76
66100		UMAX=B
66200		IF(JMAX)GO TO 3
66300		IF(M.EQ.KN)GO TO 3
66400		IF(M.EQ.K)GO TO 3
66500		UMAX=UMAX+1
66600		GO TO 3
66700	13	IF(B.GT.DMAX)GO TO 3
66800		DMAX=B
66900		IF(JMAX)GO TO 3
67000		IF(M.EQ.KN)GO TO 3
67100		IF(M.EQ.K)GO TO 3
67200		DMAX=DMAX-1
67300	3	CONTINUE
67400	C  LOOKS FOR LOWER AND HIGHER NOTES THAN NOTE 1.
67500	4	IF(MODE.EQ.5)GO TO 62
67600		K=IT
67700	C  FOR EXTRA BEAMS WITH CHORDS. K WAS SAVED IN "IT"
67800		AA=A
67900		BB=B
68000		C=1
68100		IF(X.LT.20.)GO TO 48
68200	C  JUMP IF STEM IS UP
68300		CALL EXCH(AA,BB)
68400		C=-C
68500		CALL EXCH(UMAX,DMAX)
68600	48	IF(AA.LT.BB)GO TO 45
68700		IF(UMAX.EQ.A)GO TO 46
68800	47	A=UMAX-C
68900		B=A
69000		GO TO 444
69100	46	IF(UMAX.GT.AA)GO TO 47
69200		GO TO 49
69300	45	IF(UMAX.NE.B)GO TO 47
69400	49	A=AA
69500		B=BB
69600		IF(X.GE.20)CALL EXCH(A,B)
69700	
69800	444	RN(2+IS)=STAFF 
69900	446	DIS=(RN(IS+6)-RN(IS+3))/DFAC
70000	C  FOR TILT LATER -- DFAC IS IN DATA
70100		IF(ABS(A-B).LT.DIS)GO TO 143
70200		C=C*DIS
70300	C  NEW TILT ROUTINE.  CONSIDERS DISTANCE:HEIGHT
70400	C  LIMITS SLOPE OF BEAM
70500		IF(X.GE.20)GO TO 141
70600		IF(B.GT.A)GO TO 140
70700	142	B=A-C
70800		GO TO 143
70900	141	IF(B.GT.A)GO TO 142
71000	140	A=B-C
71100	
71200	143	BB=A
71300		IF(STMDR.GE.20)GO TO 530
71400		IF(B.LT.A)BB=B
71500	C BB IS LOWEST SIDE OF BEAM
71600		IF(BB.GE.0)GO TO 14
71800	C BEAM WILL ALWAYS TOUCH MIDDLE LINE OF STAFF
71900		BB=-BB
71950		GO TO 430
72500	530	IF(B.GT.A)BB=B
72600	C FOR STEMS DOWN
72800		IF(BB.LE.14)GO TO 14
72900	C BEAMS WILL ALWAYS TOUCH MIDDLE LINE OF STAFF
73000		BB=14-BB
73100	430	A=A+BB
73133		B=B+BB
73166	C  GETS NEW HEIGHT NUMBERS.
73200	
73300	14	IF(MB.EQ.0)GO TO 330
73400	C NEXT FOR GRACE NOTE BEAMS (MB=-1)
73500		C=100
73600		IF(A)C=-C
73700		A=A+C
73800	330	RN(4+IS)=A
73900		RN(5+IS)=B
74000	C   MAKES HORIZONTAL BEAMS IF PATTERN IS UP-DOWN.
74100	C*******??????	RN(6+IS)=R(3,K)
74200	C  ABOVE IS POS.2
74300		GO TO 510
74400	
74500	C   NEXT IS FOR ACCENTS AND OTHER MARKS
74600	
74700	30	IF(JREP)CALL MARKS(RA)
74800		RB=0
74900	C%%%%%%%%
75000		J=J+1
75100		IF(RA.GE.30.AND.RA.LE.35)VX(J+1)=0
75200	C THIS  ↑↑↑↑ CATCHES FINGERING NUM.(0-5)  IT WAS READ IN MARKS.
75300		IF(RA.EQ.99)RA=VX(J)
75400	C  IF STEM IS DOWN OR THERE ARE NOTES BELOW(DBL STP), POSITION
75500	C    OF ACCENT WILL BE INVERTED.
75600	130	IF(RA.LT.37)GO TO 304
75700	C  37=RIT.
75800		NN=6
75900		BB=-6
76000		A=3
76100		B=3
76200		IF(XNOTE(K).LT.3)BB=XNOTE(K)-7.5
76300	C LOWERS ITEM IF NOTE BELOW STAFF.  BUT IS 'K' ALWAYS OK HERE??????
76400		IF(RA.LT.99)GO TO 305
76500	C NEXT FOR CRESC. & DECRSC. LINES<,>. TYPE /NT1 C+ NT2/ OR /N1.d  C- N2.d/
76600	C ALSO FOR "8va ----" /NT1 O NT2/
76700		NN=8
76800		BB=BB+2.5
76900		A=5
77000		B=4
77100		RB=50
77200		IF(RA.NE.208)GO TO 306
77300		RB=0
77400		B=7
77500		BB=15
77600	C  LATER ADD CHECK FOR HEIGHT OF NOTES UNDER 8va.
77700	306	RN(IS+7)=RA-200
77800	C  MAKES ZERO OR -1 OR 8 IN P7
77900		RA=RB
78000	C  ADDS A NEW ITEM.  MP, PP, CRESC., ETC. --CODE 3
78100	305	RN(IS)=A
78200		RN(IS+1)=B
78300		RN(IS+2)=STAFF
78400	C  PUTS MF, ETC. BETWEEN NOTES.  (I HOPE)  SEE 'FUNCTION POSIT' BELOW
78500		RN(IS+3)=POSIT(VX(J-1))-1.5
78600	C  '-1.5' PUSHES IT TO LEFT. MAYBE CHANGE ORIGINAL POSITIONS??
78700		RN(IS+4)=BB
78800	C  DIST. BELOW STAFF
78900		RN(IS+5)=RA
79000	C  THE CODE NUM IN 'CLEFS' LIST
79100		IS=IS+NN
79200		IF(NN.EQ.6)GO TO 230
79300		J=J+1
79400		RA=POSIT(VX(J))
79500		IF(RB.EQ.0)RA=RA+3
79600	C RB=0= 8va
79700		RN(IS-2)=RA
79800	C  THIS IS P6 (POS2 FOR CRESC. LINES)
79900		GO TO 514
80000	CS304	RB=R(6,K)
80100	CS	B=10.
80200	CS	IF(RA.EQ.6)RA=26.
80300	C TEMPORARY CHANGE FOR FERMATA*******
80400	CS	IF(RA.GT.10.)RA=RA/10.
80500	CS	A=ABS(AMOD(RB,1.))
80600	CS	IF(A.EQ.0)GO TO 301
80700	CS	IF(RA.GT.3)GO TO 303
80800	CS	RB=FLOAT(IFIX(RB))
80900	CS	RA=RA+A/10.
81000	C  THIS PUTS 2-DIGIT CODE BEFORE 1-DIGIT CODE.
81100	CS	GO TO 301
81200	CS303	IF(A.LT..3)GO TO 302
81300	CS	B=100.
81400	CS	GO TO 301
81500	CS302	B=1000.
81600	CS301	IF(RB.LT.0)RA=-RA
81700	CS	R(6,K)=RB+RA/B
81800	304	RB=R(2,K)
81900		IF(RA.EQ.6)RA=26.
82000		A=RA
82100		IF(RB.EQ.0)GO TO 301
82200		IF(RB.GE.10)GO TO 303
82300		A=A*100
82400		GO TO 301
82500	303	RB=RB*100
82600	301	R(2,K)=RB+A
82700	C  P11 INFO(MARKS) IS TEMPORARILY STORED IN P2 (STAFF# IS IN STAFF)
82800	230	A=VX(J)
82900		JREP=-1
83000		IF(A.EQ.0)GO TO 514
83100	C NEXT FOR STRING OF SAME MARK ( /3 12 S/ )
83200		JREP=0
83300		J=J-1
83400		VX(J)=VX(J)+1
83500		IF(VX(J).GE.A)VX(J+1)=0
83600		J=J-1
83700		GO TO 514
83800	C   USES 4-7,9,11-13 FOR ACC. > FERM. DOT - DNBOW UPBOW HARM.
83900	C  NOTE#,ACCENT#/N,A/N,A*
84000		END
84100	
84200	CF	FUNCTION XNOTE(J)
84300	CF	COMMON/XRN/RN(4000)
84400	CF	DIMENSION R(10,80)
84500	CF	EQUIVALENCE (R,RN(3001))
84600	CF	XNOTE=AMOD(R(4,J),100.)
84700	CF	END
84800	
84900	CF	SUBROUTINE BAUTO(J,L,K,N)
85000	C  FOR AUTOMATIC BEAMS.
85100	CF	COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
85200	CF	J=J+2
85300	CF	V(J-1)=L-N
85400	CF	V(J)=K-N
85500	CF	END
85600	
85700	CF	SUBROUTINE UPDATE(I)
85800	CF	COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /XRN/RN(4000)
85900	CF	RN(IS)=I
86000	CF	IS=IS+I+3
86100	CF	END
86200	
86300	C	SUBROUTINE SLEND
86400	C	INTEGER PWDS
86500	C  TO FIND END POINTS OF STAVES
86600	C	COMMON/XRN/RN(2000),IT,POS,RA,NN,JB,RB,A,B,JMP,JK,C,DMAX,
86700	C	1 UMAX,AA,JMAX,X,Y,BB,RNX(1982)
86800	     1/SCM/V(78),I,LCNT,STAFF,LIST(200),REND/PTR/PWDS(250),ITEM,LL,IS,IX
86900	C	DO 1 K=1,ITEM
87000	C	L=PWDS(K)
87100	C	IF(RN(L+1).NE.8)GO TO 1
87200	C  FOUND A STAFF
87300	C	IF(RN(L+2).NE.STAFF)GO TO 1
87400	C GOT THE RIGHT ONE
87500	C	IF(IT)GO TO 2
87600	C	POS=202
87700	C NOW CHECK LEFT SIDE OF STAFF
87800	C	IF(RN(L).LT.4)RETURN
87900	C P6 WASN'T MENTIONED - SO IT =200
88000	C	POS=RN(L+6)+2
88100	C	IF(POS.EQ.2)POS=202
88200	C	RETURN
88300	C2	POS=RN(L+3)-2.3
88400	C	RETURN
88500	C1	CONTINUE
88600	C	END
88700	
88800	C	FUNCTION POSIT(V)
88900	C	COMMON/XRN/RN(4000)
89000	C	DIMENSION POSNT(0/82)
89100	C	EQUIVALENCE (POSNT,RN(3801))
89200	C	1,(A,RN(3884)),(K,RN(3885))
89300	C	IF(V)V=-V
89400	C  REREAD OR SOMETHING MAKES /1 C- 2/ GIVE A -2 FOR LAST NUM.!!!???
89500	C	K=V
89600	C	A=POSNT(K)
89700	C	POSIT=A+(POSNT(K+1)-A)*AMOD(V,1.0)
89800	C  TYPE  /2.3 -- FOR POSITION BETWEEN NTS 2 AND 3. ETC.
89900	C	END